home *** CD-ROM | disk | FTP | other *** search
/ Computer Select (Limited Edition) / Computer Select.iso / dobbs / v16n09 / bob.asc < prev    next >
Encoding:
Text File  |  1991-08-21  |  15.5 KB  |  668 lines
  1. _YOUR OWN TINY OBJECT-ORIENTED LANGUAGE_
  2. by David Betz
  3.  
  4. [LISTING ONE]
  5.  
  6. /* bobint.c - bytecode interpreter */
  7. /*
  8.     Copyright (c) 1991, by David Michael Betz
  9.     All rights reserved
  10. */
  11.  
  12. #include <setjmp.h>
  13. #include "bob.h"
  14.  
  15. #define iszero(x)   ((x)->v_type == DT_INTEGER && (x)->v.v_integer == 0)
  16. #define istrue(x)   ((x)->v_type != DT_NIL && !iszero(x))
  17.  
  18. /* global variables */
  19. VALUE *stkbase;     /* the runtime stack */
  20. VALUE *stktop;      /* the top of the stack */
  21. VALUE *sp;      /* the stack pointer */
  22. VALUE *fp;      /* the frame pointer */
  23. int trace=0;        /* variable to control tracing */
  24.  
  25. /* external variables */
  26. extern DICTIONARY *symbols;
  27. extern jmp_buf error_trap;
  28.  
  29. /* local variables */
  30. static unsigned char *cbase;    /* the base code address */
  31. static unsigned char *pc;   /* the program counter */
  32. static VALUE *code;     /* the current code vector */
  33.  
  34. /* forward declarations */
  35. char *typename();
  36.  
  37. /* execute - execute a bytecode function */
  38. int execute(name)
  39.   char *name;
  40. {
  41.     DICT_ENTRY *sym;
  42.     
  43.     /* setup an error trap handler */
  44.     if (setjmp(error_trap) != 0)
  45.     return (FALSE);
  46.  
  47.     /* lookup the symbol */
  48.     if ((sym = findentry(symbols,name)) == NULL)
  49.     return (FALSE);
  50.  
  51.     /* dispatch on its data type */
  52.     switch (sym->de_value.v_type) {
  53.     case DT_CODE:
  54.     (*sym->de_value.v.v_code)(0);
  55.     break;
  56. è    case DT_BYTECODE:
  57.     interpret(sym->de_value.v.v_bytecode);
  58.     break;
  59.     }
  60.     return (TRUE);
  61. }
  62.  
  63. /* interpret - interpret bytecode instructions */
  64. int interpret(fcn)
  65.   VALUE *fcn;
  66. {
  67.     register int pcoff,n;
  68.     register VALUE *obj;
  69.     VALUE *topframe,val;
  70.     STRING *s1,*s2,*sn;
  71.     
  72.     /* initialize */
  73.     sp = fp = stktop;
  74.     cbase = pc = fcn[1].v.v_string->s_data;
  75.     code = fcn;
  76.  
  77.     /* make a dummy call frame */
  78.     check(4);
  79.     push_bytecode(code);
  80.     push_integer(0);
  81.     push_integer(0);
  82.     push_integer(0);
  83.     fp = topframe = sp;
  84.     
  85.     /* execute each instruction */
  86.     for (;;) {
  87.     if (trace)
  88.         decode_instruction(code,pc-code[1].v.v_string->s_data);
  89.     switch (*pc++) {
  90.     case OP_CALL:
  91.         n = *pc++;
  92.         switch (sp[n].v_type) {
  93.         case DT_CODE:
  94.             (*sp[n].v.v_code)(n);
  95.             break;
  96.         case DT_BYTECODE:
  97.             check(3);
  98.             code = sp[n].v.v_bytecode;
  99.             push_integer(n);
  100.             push_integer(stktop - fp);
  101.             push_integer(pc - cbase);
  102.             cbase = pc = code[1].v.v_string->s_data;
  103.             fp = sp;
  104.             break;
  105.         default:
  106.             error("Call to non-procedure, Type %s",
  107.               typename(sp[n].v_type));
  108.             return;
  109.         }
  110.         break;
  111. è    case OP_RETURN:
  112.         if (fp == topframe) return;
  113.         val = *sp;
  114.         sp = fp;
  115.         pcoff = fp[0].v.v_integer;
  116.         n = fp[2].v.v_integer;
  117.         fp = stktop - fp[1].v.v_integer;
  118.         code = fp[fp[2].v.v_integer+3].v.v_bytecode;
  119.         cbase = code[1].v.v_string->s_data;
  120.         pc = cbase + pcoff;
  121.         sp += n + 3;
  122.         *sp = val;
  123.         break;
  124.     case OP_REF:
  125.         *sp = code[*pc++].v.v_var->de_value;
  126.         break;
  127.     case OP_SET:
  128.         code[*pc++].v.v_var->de_value = *sp;
  129.         break;
  130.     case OP_VREF:
  131.         chktype(0,DT_INTEGER);
  132.         switch (sp[1].v_type) {
  133.         case DT_VECTOR: vectorref(); break;
  134.         case DT_STRING: stringref(); break;
  135.         default:    badtype(1,DT_VECTOR); break;
  136.         }
  137.         break;
  138.     case OP_VSET:
  139.         chktype(1,DT_INTEGER);
  140.         switch (sp[2].v_type) {
  141.         case DT_VECTOR: vectorset(); break;
  142.         case DT_STRING: stringset(); break;
  143.         default:    badtype(1,DT_VECTOR); break;
  144.         }
  145.         break;
  146.     case OP_MREF:
  147.         obj = fp[fp[2].v.v_integer+2].v.v_object;
  148.         *sp = obj[*pc++];
  149.         break;
  150.     case OP_MSET:
  151.         obj = fp[fp[2].v.v_integer+2].v.v_object;
  152.         obj[*pc++] = *sp;
  153.         break;
  154.     case OP_AREF:
  155.         n = *pc++;
  156.         if (n >= fp[2].v.v_integer)
  157.             error("Too few arguments");
  158.         *sp = fp[n+3];
  159.         break;
  160.     case OP_ASET:
  161.         n = *pc++;
  162.         if (n >= fp[2].v.v_integer)
  163.             error("Too few arguments");
  164.         fp[n+3] = *sp;
  165.         break;
  166. è    case OP_TREF:
  167.         n = *pc++;
  168.         *sp = fp[-n-1];
  169.         break;
  170.     case OP_TSET:
  171.         n = *pc++;
  172.         fp[-n-1] = *sp;
  173.         break;
  174.     case OP_TSPACE:
  175.         n = *pc++;
  176.         check(n);
  177.         while (--n >= 0) {
  178.             --sp;
  179.             set_nil(sp);
  180.         }
  181.         break;
  182.     case OP_BRT:
  183.         if (istrue(sp))
  184.             pc = cbase + getwoperand();
  185.         else
  186.             pc += 2;
  187.         break;
  188.     case OP_BRF:
  189.         if (istrue(sp))
  190.             pc += 2;
  191.         else
  192.             pc = cbase + getwoperand();
  193.         break;
  194.     case OP_BR:
  195.         pc = cbase + getwoperand();
  196.         break;
  197.     case OP_NIL:
  198.         set_nil(sp);
  199.         break;
  200.     case OP_PUSH:
  201.         check(1);
  202.         push_integer(FALSE);
  203.         break;
  204.     case OP_NOT:
  205.         if (istrue(sp))
  206.             set_integer(sp,FALSE);
  207.         else
  208.             set_integer(sp,TRUE);
  209.         break;
  210.     case OP_NEG:
  211.         chktype(0,DT_INTEGER);
  212.         sp->v.v_integer = -sp->v.v_integer;
  213.         break;
  214.     case OP_ADD:
  215.         switch (sp[1].v_type) {
  216.         case DT_INTEGER:
  217.             switch (sp[0].v_type) {
  218.             case DT_INTEGER:
  219.             sp[1].v.v_integer += sp->v.v_integer;
  220.             break;
  221. è            case DT_STRING:
  222.             s2 = sp[0].v.v_string;
  223.             sn = newstring(1 + s2->s_length);
  224.             sn->s_data[0] = sp[1].v.v_integer;
  225.             memcpy(&sn->s_data[1],
  226.                    s2->s_data,
  227.                    s2->s_length);
  228.             set_string(&sp[1],sn);
  229.             break;
  230.             default:
  231.             break;
  232.             }
  233.             break;
  234.         case DT_STRING:
  235.             s1 = sp[1].v.v_string;
  236.             switch (sp[0].v_type) {
  237.             case DT_INTEGER:
  238.             sn = newstring(s1->s_length + 1);
  239.             memcpy(sn->s_data,
  240.                    s1->s_data,
  241.                    s1->s_length);
  242.             sn->s_data[s1->s_length] = sp[0].v.v_integer;
  243.             set_string(&sp[1],sn);
  244.             break;
  245.             case DT_STRING:
  246.             s2 = sp[0].v.v_string;
  247.             sn = newstring(s1->s_length + s2->s_length);
  248.             memcpy(sn->s_data,
  249.                    s1->s_data,s1->s_length);
  250.             memcpy(&sn->s_data[s1->s_length],
  251.                    s2->s_data,s2->s_length);
  252.             set_string(&sp[1],sn);
  253.             break;
  254.             default:
  255.             break;
  256.             }
  257.             break;
  258.         default:
  259.             badtype(1,DT_VECTOR);
  260.             break;
  261.         }
  262.         ++sp;
  263.         break;
  264.     case OP_SUB:
  265.         chktype(0,DT_INTEGER);
  266.         chktype(1,DT_INTEGER);
  267.         sp[1].v.v_integer -= sp->v.v_integer;
  268.         ++sp;
  269.         break;
  270.     case OP_MUL:
  271.         chktype(0,DT_INTEGER);
  272.         chktype(1,DT_INTEGER);
  273.         sp[1].v.v_integer *= sp->v.v_integer;
  274.         ++sp;
  275.         break;
  276. è    case OP_DIV:
  277.         chktype(0,DT_INTEGER);
  278.         chktype(1,DT_INTEGER);
  279.         if (sp->v.v_integer != 0) {
  280.             int x=sp->v.v_integer;
  281.             sp[1].v.v_integer /= x;
  282.         }
  283.         else
  284.             sp[1].v.v_integer = 0;
  285.         ++sp;
  286.         break;
  287.     case OP_REM:
  288.         chktype(0,DT_INTEGER);
  289.         chktype(1,DT_INTEGER);
  290.         if (sp->v.v_integer != 0) {
  291.             int x=sp->v.v_integer;
  292.             sp[1].v.v_integer %= x;
  293.         }
  294.         else
  295.             sp[1].v.v_integer = 0;
  296.         ++sp;
  297.         break;
  298.     case OP_INC:
  299.         chktype(0,DT_INTEGER);
  300.         ++sp->v.v_integer;
  301.         break;
  302.     case OP_DEC:
  303.         chktype(0,DT_INTEGER);
  304.         --sp->v.v_integer;
  305.         break;
  306.     case OP_BAND:
  307.         chktype(0,DT_INTEGER);
  308.         chktype(1,DT_INTEGER);
  309.         sp[1].v.v_integer &= sp->v.v_integer;
  310.         ++sp;
  311.         break;
  312.     case OP_BOR:
  313.         chktype(0,DT_INTEGER);
  314.         chktype(1,DT_INTEGER);
  315.         sp[1].v.v_integer |= sp->v.v_integer;
  316.         ++sp;
  317.         break;
  318.     case OP_XOR:
  319.         chktype(0,DT_INTEGER);
  320.         chktype(1,DT_INTEGER);
  321.         sp[1].v.v_integer ^= sp->v.v_integer;
  322.         ++sp;
  323.         break;
  324.     case OP_BNOT:
  325.         chktype(0,DT_INTEGER);
  326.         sp->v.v_integer = ~sp->v.v_integer;
  327.         break;
  328.     case OP_SHL:
  329.         switch (sp[1].v_type) {
  330.         case DT_INTEGER:
  331. è            chktype(0,DT_INTEGER);
  332.             sp[1].v.v_integer <<= sp->v.v_integer;
  333.             break;
  334.         case DT_FILE:
  335.             print1(sp[1].v.v_fp,FALSE,&sp[0]);
  336.             break;
  337.         default:
  338.             break;
  339.         }
  340.         ++sp;
  341.         break;
  342.     case OP_SHR:
  343.         chktype(0,DT_INTEGER);
  344.         chktype(1,DT_INTEGER);
  345.         sp[1].v.v_integer >>= sp->v.v_integer;
  346.         ++sp;
  347.         break;
  348.     case OP_LT:
  349.         chktype(0,DT_INTEGER);
  350.         chktype(1,DT_INTEGER);
  351.         n = sp[1].v.v_integer < sp->v.v_integer;
  352.         ++sp;
  353.         set_integer(sp,n ? TRUE : FALSE);
  354.         break;
  355.     case OP_LE:
  356.         chktype(0,DT_INTEGER);
  357.         chktype(1,DT_INTEGER);
  358.         n = sp[1].v.v_integer <= sp->v.v_integer;
  359.         ++sp;
  360.         set_integer(sp,n ? TRUE : FALSE);
  361.         break;
  362.     case OP_EQ:
  363.         chktype(0,DT_INTEGER);
  364.         chktype(1,DT_INTEGER);
  365.         n = sp[1].v.v_integer == sp->v.v_integer;
  366.         ++sp;
  367.         set_integer(sp,n ? TRUE : FALSE);
  368.         break;
  369.     case OP_NE:
  370.         chktype(0,DT_INTEGER);
  371.         chktype(1,DT_INTEGER);
  372.         n = sp[1].v.v_integer != sp->v.v_integer;
  373.         ++sp;
  374.         set_integer(sp,n ? TRUE : FALSE);
  375.         break;
  376.     case OP_GE:
  377.         chktype(0,DT_INTEGER);
  378.         chktype(1,DT_INTEGER);
  379.         n = sp[1].v.v_integer >= sp->v.v_integer;
  380.         ++sp;
  381.         set_integer(sp,n ? TRUE : FALSE);
  382.         break;
  383.     case OP_GT:
  384.         chktype(0,DT_INTEGER);
  385.         chktype(1,DT_INTEGER);
  386. è        n = sp[1].v.v_integer > sp->v.v_integer;
  387.         ++sp;
  388.         set_integer(sp,n ? TRUE : FALSE);
  389.         break;
  390.     case OP_LIT:
  391.         *sp = code[*pc++];
  392.         break;
  393.     case OP_SEND:
  394.         n = *pc++;
  395.         chktype(n,DT_OBJECT);
  396.         send(n);
  397.         break;
  398.     case OP_DUP2:
  399.         check(2);
  400.         sp -= 2;
  401.         *sp = sp[2];
  402.         sp[1] = sp[3];
  403.         break;
  404.     case OP_NEW:
  405.         chktype(0,DT_CLASS);
  406.         set_object(sp,newobject(sp->v.v_class));
  407.         break;
  408.     default:
  409.         info("Bad opcode %02x",pc[-1]);
  410.         break;
  411.     }
  412.     }
  413. }
  414.  
  415. /* send - send a message to an object */
  416. static send(n)
  417.   int n;
  418. {
  419.     char selector[TKNSIZE+1];
  420.     DICT_ENTRY *de;
  421.     CLASS *class;
  422.     class = sp[n].v.v_object[OB_CLASS].v.v_class;
  423.     getcstring(selector,sizeof(selector),sp[n-1].v.v_string);
  424.     sp[n-1] = sp[n];
  425.     do {
  426.     if ((de = findentry(class->cl_functions,selector)) != NULL) {
  427.         switch (de->de_value.v_type) {
  428.         case DT_CODE:
  429.         (*de->de_value.v.v_code)(n);
  430.         return;
  431.         case DT_BYTECODE:
  432.         check(3);
  433.         code = de->de_value.v.v_bytecode;
  434.         set_bytecode(&sp[n],code);
  435.         push_integer(n);
  436.         push_integer(stktop - fp);
  437.         push_integer(pc - cbase);
  438.         cbase = pc = code[1].v.v_string->s_data;
  439.         fp = sp;
  440.         return;
  441. è        default:
  442.         error("Bad method, Selector '%s', Type %d",
  443.               selector,
  444.               de->de_value.v_type);
  445.         }
  446.     }
  447.     } while ((class = class->cl_base) != NULL);
  448.     nomethod(selector);
  449. }
  450.  
  451. /* vectorref - load a vector element */
  452. static vectorref()
  453. {
  454.     VALUE *vect;
  455.     int i;
  456.     vect = sp[1].v.v_vector;
  457.     i = sp[0].v.v_integer;
  458.     if (i < 0 || i >= vect[0].v.v_integer)
  459.     error("subscript out of bounds");
  460.     sp[1] = vect[i+1];
  461.     ++sp;
  462. }
  463.  
  464. /* vectorset - set a vector element */
  465. static vectorset()
  466. {
  467.     VALUE *vect;
  468.     int i;
  469.     vect = sp[2].v.v_vector;
  470.     i = sp[1].v.v_integer;
  471.     if (i < 0 || i >= vect[0].v.v_integer)
  472.     error("subscript out of bounds");
  473.     vect[i+1] = sp[2] = *sp;
  474.     sp += 2;
  475. }
  476.  
  477. /* stringref - load a string element */
  478. static stringref()
  479. {
  480.     STRING *str;
  481.     int i;
  482.     str = sp[1].v.v_string;
  483.     i = sp[0].v.v_integer;
  484.     if (i < 0 || i >= str->s_length)
  485.     error("subscript out of bounds");
  486.     set_integer(&sp[1],str->s_data[i]);
  487.     ++sp;
  488. }
  489.  
  490. /* stringset - set a string element */
  491. static stringset()
  492. {
  493.     STRING *str;
  494.     int i;
  495.     chktype(0,DT_INTEGER);
  496. è    str = sp[2].v.v_string;
  497.     i = sp[1].v.v_integer;
  498.     if (i < 0 || i >= str->s_length)
  499.     error("subscript out of bounds");
  500.     str->s_data[i] = sp[0].v.v_integer;
  501.     set_integer(&sp[2],str->s_data[i]);
  502.     sp += 2;
  503. }
  504.  
  505. /* getwoperand - get data word */
  506. static int getwoperand()
  507. {
  508.     int b;
  509.     b = *pc++;
  510.     return ((*pc++ << 8) | b);
  511. }
  512.  
  513. /* type names */
  514. static char *tnames[] = {
  515. "NIL","CLASS","OBJECT","VECTOR","INTEGER","STRING","BYTECODE",
  516. "CODE","VAR","FILE"
  517. };
  518.  
  519. /* typename - get the name of a type */
  520. static char *typename(type)
  521.   int type;
  522. {
  523.     static char buf[20];
  524.     if (type >= _DTMIN && type <= _DTMAX)
  525.     return (tnames[type]);
  526.     sprintf(buf,"(%d)",type);
  527.     return (buf);
  528. }
  529.  
  530. /* badtype - report a bad operand type */
  531. badtype(off,type)
  532.   int off,type;
  533. {
  534.     char tn1[20];
  535.     strcpy(tn1,typename(sp[off].v_type));
  536.     info("PC: %04x, Offset %d, Type %s, Expected %s",
  537.      pc-cbase,off,tn1,typename(type));
  538.     error("Bad argument type");
  539. }
  540.  
  541. /* nomethod - report a failure to find a method for a selector */
  542. static nomethod(selector)
  543.   char *selector;
  544. {
  545.     error("No method for selector '%s'",selector);
  546. }
  547.  
  548. /* stackover - report a stack overflow error */
  549. stackover()
  550. {
  551. è    error("Stack overflow");
  552. }
  553.  
  554.  
  555.  
  556.  
  557. Examplσ 1║ 
  558.  
  559. (a⌐ 
  560.  
  561.     factorial(n)
  562.     {
  563.         return n == 1 ? 1 : n * factorial(n-1);
  564.  
  565.     }
  566.  
  567.  
  568.  
  569. (b⌐ 
  570.  
  571.  
  572.     main(; i)
  573.     {
  574.         for (i = 1; i <= 10; ++i)
  575.             print(i," factorial is ",factorial(i),"\n");
  576.     }
  577.  
  578.  
  579.  
  580. Examplσ 2:
  581.  
  582. (a⌐ ┴ BoΓ clas≤ definition
  583.  
  584.     clas≤ foo
  585.     {
  586.         a,b;
  587.         statiπ last;
  588.         statiπ get_last();
  589.     }
  590.  
  591.  
  592. (b⌐ 
  593.  
  594.     foo::foo(aa,bb)
  595.     {
  596.         a == aa; b = bb;
  597.         last = this;
  598.         return this;
  599.     }
  600.  
  601.  
  602.  
  603.  
  604.  
  605. Examplσ 3:
  606. è
  607. (a)
  608.     foo::get_a()
  609.     {
  610.         return a;
  611.     }
  612.  
  613.  
  614.  
  615. (b)
  616.  
  617.     foo::set_a(aa)
  618.     {
  619.         a = aa;
  620.     }
  621.  
  622.  
  623. (c)
  624.  
  625.  
  626.     foo::count(; i)
  627.     {
  628.         for (i = a; i <= b; ++i)
  629.             print(i,"\n");
  630.     }
  631.  
  632.     main(; foo1,foo2)
  633.     {
  634.  
  635.         foo1 = new foo(1,2);      // create a object of class foo
  636.         foo2 = new foo(11,22);    // and another
  637.         print("foo1 counting\n"); // ask the first to count
  638.         foo1->count();
  639.         print("foo2 counting\n"); // ask the second to count
  640.         foo2->count();
  641.     }
  642.  
  643.  
  644. Examplσ 4:
  645.  
  646. (a)
  647.  
  648.     class bar : foo // a class derived from foo
  649.     {
  650.         c;
  651.     }
  652.  
  653.  
  654. (b)
  655.  
  656.     bar::bar(aa,bb,cc)
  657.     {
  658.         this->foo(aa,bb);
  659.         return this;
  660.     }
  661. è
  662.  
  663.  
  664. Examplσ 5
  665.  
  666. typedef struct value {
  667.   int v_type;           /* data type */
  668.   union {           /* value */
  669.     struct class *v_class;
  670.     struct value *v_object;
  671.     struct value *v_vector;
  672.     struct string *v_string;
  673.  
  674.     struct value *v_bytecode;
  675.     struct dict_entry *v_var;
  676.     int (*v_code)();
  677.     long v_integer;
  678.   } v;
  679. } VALUE;
  680.